home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / lex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  2.6 KB  |  129 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     lex.c
  25.  
  26.     lexical environment
  27. */
  28.  
  29. #include "include.h"
  30.  
  31.  
  32. object
  33. assoc_eq(key, alist)
  34. object key, alist;
  35. {
  36.     while (!endp(alist)) {
  37.         if (MMcaar(alist) == key)
  38.             return(MMcar(alist));
  39.         alist = MMcdr(alist);
  40.     }
  41.     return(Cnil);
  42. }
  43.  
  44. lex_fun_bind(name, fun)
  45. object name, fun;
  46. {
  47.     object *top = vs_top;
  48.  
  49.     vs_push(make_cons(fun, Cnil));
  50.     top[0] = make_cons(Sfunction, top[0]);
  51.     top[0] = make_cons(name, top[0]);
  52.     lex_env[1] = make_cons(top[0],lex_env[1]);
  53.     vs_top = top;
  54. }
  55.  
  56. lex_macro_bind(name, exp_fun)
  57. object name, exp_fun;
  58. {
  59.     object *top = vs_top;
  60.     vs_push(make_cons(exp_fun, Cnil));
  61.     top[0] = make_cons(Smacro, top[0]);
  62.     top[0] = make_cons(name, top[0]);
  63.     lex_env[1]=make_cons(top[0], lex_env[1]);              
  64.     vs_top = top;
  65. }
  66.  
  67. lex_tag_bind(tag, id)
  68. object tag, id;
  69. {
  70.     object *top = vs_top;
  71.  
  72.     vs_push(make_cons(id, Cnil));
  73.     top[0] = make_cons(Stag, top[0]);
  74.     top[0] = make_cons(tag, top[0]);
  75.     lex_env[2] =make_cons(top[0], lex_env[2]);
  76.     vs_top = top;
  77. }
  78.  
  79. lex_block_bind(name, id)
  80. object name, id;
  81. {
  82.     object *top = vs_top;
  83.  
  84.     vs_push(make_cons(id, Cnil));
  85.     top[0] = make_cons(Sblock, top[0]);
  86.     top[0] = make_cons(name, top[0]);
  87.     lex_env[2]= make_cons(top[0], lex_env[2]);
  88.     vs_top = top;
  89. }
  90.  
  91. object
  92. lex_tag_sch(tag)
  93. object tag;
  94. {
  95.     object alist = lex_env[2];
  96.  
  97.     while (!endp(alist)) {
  98.         if (eql(MMcaar(alist), tag) && MMcadar(alist) == Stag)
  99.             return(MMcar(alist));
  100.         alist = MMcdr(alist);
  101.     }
  102.     return(Cnil);
  103. }
  104.  
  105. object lex_block_sch(name)
  106. object name;
  107. {
  108.     object alist = lex_env[2];
  109.  
  110.     while (!endp(alist)) {
  111.         if (MMcaar(alist) == name && MMcadar(alist) == Sblock)
  112.             return(MMcar(alist));
  113.         alist = MMcdr(alist);
  114.     }
  115.     return(Cnil);
  116. }
  117.  
  118. init_lex()
  119. {
  120.     Sfunction = make_ordinary("FUNCTION");
  121.     enter_mark_origin(&Sfunction);
  122.     Smacro = make_ordinary("MACRO");
  123.     enter_mark_origin(&Smacro);
  124.     Stag = make_ordinary("TAG");
  125.     enter_mark_origin(&Stag);
  126.     Sblock =  make_ordinary("BLOCK");
  127.     enter_mark_origin(&Sblock);
  128. }
  129.